home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Module source / sharedLibMod.txt < prev    next >
Text File  |  1998-12-03  |  8KB  |  339 lines
  1. \                =================================
  2. \                        Shared libraries
  3. \                =================================
  4.  
  5.  
  6. (*
  7.     Usage:
  8.  
  9.     LIBRARY myLib
  10.  
  11.     LIBCALL myCall { parm1 parm2 %fparm1 -- res1 }
  12.  
  13.  
  14.     The old syntax (Mops 3.2) will still be supported for a while:
  15.     
  16.     1  1 1 1 3  extern  myLib  myCall
  17.     
  18.     or for a floating routine:
  19.     
  20.     1 kFloat or  1 kFloat or  1 kFloat or  2  extern myOtherLib  myFloatGizmo
  21.  
  22.     defined as:
  23.  
  24.     EXTERN <lib_name> <call_name>
  25.             ( #result_cells #parm1_cells ... #parmN_cells N -- )
  26.  
  27. *)
  28.  
  29. : ADD_CASE_SENSITIVE_NAME
  30.     bl word
  31.     count  1+ #align4  ++> CDP
  32.     drop
  33. ;
  34.  
  35. : LIBRARY  { \    svCaseFlg sv-in addr len ^len-byte  name_len -- }
  36.     ?exec
  37.     >in @  -> sv-in        \ so we can read the name again case-sensitively
  38.  
  39. \ if we've already defined it as a library, and it's currently
  40. \  FINDable, we don't need to define it again here.
  41.  
  42.     defined?
  43.     IF    2- w@  $ BF0B =  ?EXIT
  44.     ELSE
  45.         drop
  46.     THEN
  47.  
  48.     sv-in  >in !                \ get name again for header
  49.     header  $ BF0B0000  code,    \  $BF0B = handler code for LIBRARY,
  50.                                 \   plus alignment
  51.  
  52.     DP  0 ,                        \ put 0 in data area - means no connID yet
  53.     relocCode,                    \ and reloc pointer to there in code area
  54.     
  55.     sv-in  >in !                \ now we have to get the name again, case-sensitively
  56.     add_case_sensitive_name        \  this time, and just add it to the code area.  We'll
  57.                                 \  use this when we connect to the library.
  58. ;
  59.  
  60.  
  61.  
  62. \ EXTERN <lib_name> <call_name>
  63. \        ( #result_cells #parm1_cells ... #parmN_cells N -- )
  64.  
  65. \ Some of this is a bit like MAC_EXTERN above, and some a bit
  66. \  like SYSCALL, but then it's a bit different too, so I won't
  67. \  try to factor bits out - it's trickier than it looks.
  68.  
  69.  
  70. : EXTERN  ( result-info parm-info #parms )
  71.         { \ #parms #parm_cells #res_cells #fparms #fres mask ^lib ^info sv_in -- }
  72.  
  73.     -> #parms
  74.  
  75.     0 -> #parm_cells  0 -> #fparms  0 -> #fres  0 -> mask
  76.     0 -> #res_cells
  77.  
  78.     #parms
  79.     IF
  80.         #parms FOR
  81.     
  82.         (*    #cells in next parm.  If the hi byte is set, that means
  83.             it's floating point - in that case we count up the number of 
  84.             floating parms (these have to  be put in the FPRs for the call), 
  85.             and set the corresponding mask bit so that the corresponding 
  86.             GPRs will get a dummy value.  This calling convention is a bit 
  87.             crazy, but we're stuck with it.  Remember as the numbers have 
  88.             been pushed onto the stack, we're going from the last parm 
  89.             backwards.  So i in this FOR loop gives us the real parm# 
  90.             starting from zero.
  91.         *)        
  92.             dup $ FF00 and
  93.             IF                \ it's floating
  94.                 1 ++> #fparms
  95.                 drop  2        \ an FP parm is always 8 bytes = 2 cells
  96.                 mask 2 >>  $ C000 or  -> mask    \ mask 2 dummy GPRs here
  97.             ELSE
  98.                 mask 1 >>  -> mask                \ normal GPR cell - no mask bit
  99.             THEN
  100.             ++> #parm_cells
  101.     
  102.         NEXT
  103.     THEN
  104.  
  105. ( result-info )
  106.     dup $ FF00 and
  107.     IF                                \ PPC result is floating - so no integer result
  108.         1 -> #fres  drop 0
  109.     THEN                            \ otherwise there's no floating result
  110.  
  111.     -> #res_cells            \ number of result integer cells
  112.     
  113.     defined?                \ get library name
  114.     NIF  abort" library name not defined"  THEN
  115.     -> ^lib
  116.     ^lib 2- w@  $ BF0B <>  abort" that must be a library name"
  117.  
  118.     >in @  -> sv_in
  119.  
  120. \ now, if we've already defined it as an EXTERN and it's currently
  121. \  FINDable, we don't need to define it again here.
  122.  
  123.     defined?
  124.     IF        2- w@  $ BF01 =  ?EXIT
  125.     ELSE    drop
  126.     THEN
  127.  
  128.     sv_in  >in !
  129.     
  130.     header  $ BF01  codeW,        \ $BF01 = handler code for syscall/extern
  131.  
  132.     #parm_cells codeC,            \ 1 byte # parm cells
  133.     #res_cells codeC,            \ 1 byte # result cells
  134.     #fparms  codeC,                \ 1 byte # FP parms (in FPRs)
  135.     #fres  codeC,                \ 1 byte # FP results (in FPRs)
  136.     mask  codeW,
  137.  
  138.     DP  nilP ,                    \ put nilP in data area - means not resolved yet
  139.     relocCode,                    \ and reloc pointer to there in code area
  140.     ^lib  relocCode,            \ and reloc ptr to lib
  141.     
  142.     sv_in  >in !                \ now we have to get the name again, case-sensitively
  143.     add_case_sensitive_name        \  this time, and just add it to the code area.  We'll
  144.                                 \  use this when we resolve the symbol.
  145. ;
  146.  
  147.  
  148. \    ======================  LIBCALL  ======================
  149.  
  150.     0    value    #parm_cells        \ these values are used by declare_call
  151.     0    value    #fparms            \  which handles shared library entries.
  152.     0    value    #fres            \ We set them here, but they'll be ignored
  153.     0    value    mask            \  unless we're processing a declare_call.
  154.     0    value    #res_cells
  155.     0    value    lib_addr
  156.  
  157.  
  158. : (find_lib)  { xt dummy \ addr procInfo -- }
  159.  
  160.     xt 2- w@ $ BF0B <>  ?EXIT    \ out if this isn't a library
  161.     true -> endTrav?
  162.     xt -> lib_addr
  163. ;
  164.  
  165.  
  166. : find_lib
  167.     0 -> lib_addr
  168.     ['] (find_lib)  0  trav  ;
  169.  
  170.  
  171. : 1parm
  172.     firstChr  & % =
  173.     IF        \ it's floating
  174.         1 ++> #fparms
  175.         mask 2 >>  $ C000 or  -> mask    \ mask 2 dummy GPRs here
  176.         2                    \ an FP parm is always 8 bytes = 2 cells
  177.     ELSE
  178.         mask 1 >>  -> mask                \ normal GPR cell - no mask bit
  179.         1                    \ an integer parm is 1 cell
  180.     THEN
  181.     ++> #parm_cells
  182. ;
  183.  
  184. (*
  185. : gobble_to_}
  186.     BEGIN
  187.         firstChr  & }  <>
  188.     WHILE
  189.         Mword drop
  190.     REPEAT
  191. ;
  192. *)
  193.  
  194. : LIBCALL  { \ sv_in -- }
  195.  
  196.     0 -> #parm_cells  0 -> #fparms  0 -> #fres  0 -> mask
  197.     0 -> #res_cells
  198.  
  199.     >in @  -> sv_in
  200.  
  201. \ now, if we've already defined it as an LIBCALL and it's currently
  202. \  FINDable, we don't need to define it again here, but just skip
  203. \  to }.
  204.  
  205.     defined?
  206.     IF        2- w@  $ BF01 =
  207.             IF  gobble_to_}  EXIT  THEN
  208.     ELSE    drop
  209.     THEN
  210.  
  211.     sv_in  >in !
  212.     
  213.     header  $ BF010000  code,        \ $BF01 = handler code for syscall/libcall
  214.             \ Note, we have to leave CDP aligned so Mword ... firstChr will
  215.             \  work!  We subtract 2 back off CDP below.
  216.  
  217.     Mword drop  firstChr & { <>  ?error 218
  218.     
  219.     BEGIN                        \ Loop to process parms
  220.         Mword drop firstChr  & -  <>            \ look for --
  221.     WHILE
  222.         firstChr  & } =  ?error 111
  223.         1parm
  224.     REPEAT
  225.  
  226. \ Finally we'll gobble input until }.  But we also need to check 
  227. \  if a % comes first, as that's the way we declare a floating 
  228. \  result for declare_call.  If we don't get a %, we assume an 
  229. \  integer result.
  230.  
  231.     Mword drop  firstChr  & % =
  232.     IF        1 -> #fres
  233.             0
  234.     ELSE    firstChr & } <>  negate        \ no result -> 0
  235.                                         \ otherwise -> 1
  236.     THEN
  237.     -> #res_cells        \ number of integer result cells
  238.  
  239.     gobble_to_}
  240.  
  241. \ Now, what's the last-defined library?
  242.  
  243.     find_lib
  244.     lib_addr 0= ?error 217        \ LIBRARY must be declared earlier
  245.  
  246.     2 --> CDP
  247.     #parm_cells codeC,            \ 1 byte # parm cells
  248.     #res_cells codeC,            \ 1 byte # result cells
  249.     #fparms  codeC,                \ 1 byte # FP parms (in FPRs)
  250.     #fres  codeC,                \ 1 byte # FP results (in FPRs)
  251.     mask  codeW,
  252.  
  253.     DP  nilP ,                    \ put nilP in data area - means not resolved yet
  254.     relocCode,                    \ and reloc pointer to there in code area
  255.     lib_addr  relocCode,        \ and reloc ptr to lib
  256.     
  257.     sv_in  >in !                \ now we have to get the name again, case-sensitively
  258.     add_case_sensitive_name        \  this time, and just add it to the code area.  We'll
  259.                                 \  use this when we resolve the symbol.
  260. ;
  261.  
  262.  
  263. \    ====================== :ENTRY ======================
  264.  
  265. (*    We use :ENTRY for the exported entry points for a shared library.
  266.     :ENTRY is rather like :, but sets the entry? flag because the named
  267.     parms can go into different regs.  It also gets a different handler
  268.     code ($BE05) so that any callers will know about the different
  269.     parameter rules, and also so we can TRAV for exported entries at PEF
  270.     time to set up the exported symbols.
  271. *)
  272.  
  273.  
  274. (* ***** now in zObjInit.
  275.  
  276. :ppc_code :entry_code
  277.     rOSSP    -256    rOSSP    stwu,
  278.     RTOC    20        rOSSP    stw,
  279.     r13        100        rOSSP    stw,
  280.     r14        104        rOSSP    stw,
  281.     r15        108        rOSSP    stw,
  282.     r16        112        rOSSP    stw,
  283.     r17        116        rOSSP    stw,
  284.     r18        120        rOSSP    stw,
  285.     r19        124        rOSSP    stw,
  286.  
  287.     r13        104        rTOC    lwz,
  288.     r14        108        rTOC    lwz,
  289.     r15        112        rTOC    lwz,
  290.     r16        116        rTOC    lwz,
  291.     r17        120        rTOC    lwz,
  292.     r18        124        rTOC    lwz,
  293.     r19        128        rTOC    lwz,
  294. ;ppc_code
  295.  
  296. :ppc_code ;entry_code
  297.     r13        100        rOSSP    lwz,
  298.     r14        104        rOSSP    lwz,
  299.     r15        108        rOSSP    lwz,
  300.     r16        112        rOSSP    lwz,
  301.     r17        116        rOSSP    lwz,
  302.     r18        120        rOSSP    lwz,
  303.     r19        124        rOSSP    lwz,
  304.     rOSSP    0        rOSSP    lwz,        \ take down frame
  305.                             blr,
  306.  
  307. ;ppc_code
  308.  
  309. ***** *)
  310.  
  311.  
  312. : :ENTRY  { \ sv_in -- }
  313.     >in @  -> sv_in
  314.     code_align
  315.     $ BF0C0000 code,            \ marker for case sensitive name
  316.     add_case_sensitive_name
  317.     sv_in  >in !                \ now we have to get the name again
  318.                                 \  for a normal colon-style header
  319.     postpone :
  320.     true -> entry?
  321.     false -> leaf?                \ :entry never uses our leaf call protocol
  322.     $ BE05  latest name> 2- w!
  323.     drop 307                    \ use our own security marker
  324. ;        immediate
  325.  
  326.  
  327. : ;ENTRY
  328.     307 ?defn
  329.     300  postpone ;
  330.     4 --> CDP                    \ delete the blr
  331.  
  332.     ['] ;entry_code 2+  CDP  36  aligned_move
  333.     36 ++> CDP
  334.     
  335.     ['] :entry_code 2+
  336.     curr-def
  337.     72  aligned_move
  338. ;        immediate
  339.